BBS in a Box 7/BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso/Files/Tele/Pete Johnson/FC LogScan 1.0.2<source>.cpt/StringFunctions Unit.p

Text File | 1991-10-18 | 8.3 KB | 283 lines | [TEXT/PJMM]

{    StringFunctions Unit                                                                            }
{    By: Jon Wind                                                                                    }
{    CIS: [70167,3444]        GENIE: JPWIND        AMERICA ONLINE: JWIND                }
{                                                                                                    }
{    Intro.                                                                                            }
{    -----                                                                                            }
{    I wrote this unit to provide an easy means of manipulating 'STR ' and 'STR#'            }
{    resources which are stored in an application's resource fork.                            }
{                                                                                                    }
{    This unit is free and may be used however you like.  But please do not redistribute    }
{    modified copies without my permission!                                                    }
{                                                                                                    }
{    Usage                                                                                            }
{    ------                                                                                            }
{                                                                                                    }
{    Most of the procedures in this unit are functions, but they could be easily modified    }
{    to work as procedures if you'd rather not deal with returned values.                    }
{                                                                                                    }
{    Call CreateEmptyStr to create a new, empty 'STR ' or 'STR#' resource.  Then     call    }
{    SetIndString to store a new entry into a 'STR#' resource, or SetStr to store a new    }
{    string into a 'STR ' resource.                                                                }
{                                                                                                    }
{    Call GetIndStr to get a 'STR#' entry or call GetStr to get a 'STR ' entry.  Call            }
{    GetTotalStr to get the total number of entries in a 'STR#' resource.                    }
{                                                                                                    }
{    Call aNum2Str, aStr2Num, Replace, ReplaceAll, Lower, and CapitalizeWords to         }
{    perform some more handy string processing.                                                }
{                                                                                                    }
{    Updates                                                                                        }
{    -------                                                                                        }
{                                                                                                    }
{    7/5/90    :    Added a few more comments, removed a DisposHandle that wasn't        }
{                    needed, and added HNoPurge and HPurge lines.                                }
{                                                                                                    }
{                                                                                                    }
unit StringFunctions;

interface


    function GetTotalStr (theID: Integer): Integer;
{get total number of strings in 'STR#' resource - returns resNotFound if resource not found}

    function GetIndStr (theID, index: Integer): Str255;
{ GetIndString available as a function }

    function GetStr (theID: Integer): Str255;
{ GetString available as a function }

    function SetIndString (theID, index: Integer; newStr: Str255): OSErr;
{ Set 'STR#' resource entry to a specific string }

    function SetStr (theID: Integer; newStr: Str255): OSErr;
{ Set 'STR ' resource to a specific string }

    function CreateEmptyStr (theType: ResType; theID: Integer): OSErr;
{ create new, empty 'STR#' or 'STR ' resource - returns result from AddResource }

    function aNum2Str (aNum: LongInt): Str255;
{ converts a number to a string - NumToString available as a function }

    function aStr2Num (NumStr: Str255): LongInt;
{ converts a string to a number - StringToNum available as a function }
{ Note: won't accurately return numbers if letters are in NumStr }

    procedure Replace (var strvar: Str255; oldstr, newstr: Str255);
{ replace or delete a portion of a string }

    procedure ReplaceAll (var strvar: Str255; oldstr, newstr: Str255);
{ replace or delete all occurances of oldstr in string Var }

    procedure Lower (var strvar: str255);
{ convert a string to lower case including those w/ diacritical marks }

    procedure CapitalizeWords (var strvar: str255);
{ attempts to capitalize words in a string }



implementation



    function GetTotalStr;{ (theID: Integer): Integer}
        var
            thePtr: ^Integer;
            Hndl: Handle;
    begin
        Hndl := GetResource('STR#', theID);            { use Get1Resource to limit search to current resource fork }
        if Hndl <> nil then
            begin
                thePtr := Pointer(ord4(hndl^));
                GetTotalStr := thePtr^;
                ReleaseResource(Hndl);
            end
        else
            GetTotalStr := resNotFound;
    end;  { of func GetTotalStr }


    function GetIndStr; {(theID, index: Integer): Str255}
        var
            theString: Str255;
    begin
        GetIndString(theString, theID, index);
        GetIndStr := theString;
    end;  { of func GetIndStr }


    function GetStr;{ (theID: Integer): Str255}
        var
            S1: StringHandle;
    begin
        S1 := GetString(theID);
        GetStr := S1^^;
    end;  { of func GetStr }


    function SetIndString; {(theID, index: Integer; newStr: Str255): OSErr}
        var
            offset, place: LongInt;
            Hndl: Handle;
            TotalStrings: ^Integer;
            i, theError: Integer;
            EmptyCh: char;

    begin
        EmptyCh := char(0);
        Hndl := GetResource('STR#', theID);            { use Get1Resource to limit search to current resource fork }
        if Hndl <> nil then
            begin
                HNoPurge(Hndl);
                TotalStrings := Pointer(ord4(hndl^));
                if index > TotalStrings^ then            { append string(s) }
                    begin
                        for i := Succ(TotalStrings^) to Pred(index) do
                            place := PtrAndHand(Pointer(Ord4(@EmptyCh) + 1), Hndl, 1);        { append nul to STR# }
                        place := PtrAndHand(Pointer(Ord4(@newStr)), Hndl, Succ(Length(newStr)));    { append string to STR# }
                        TotalStrings^ := index;            { set number of strings to reflect addition(s) }
                    end
                else            { replace existing string with new string }
                    begin
                        offset := 2;
                        for i := 1 to Pred(index) do        { get character offset of specified 'STR#' entry }
                            offset := offset + Succ(Length(GetIndStr(theID, i)));
                        place := Munger(Hndl, offset, nil, Succ(Length(GetIndStr(theID, index))), Pointer(Ord4(@newStr)), Succ(Length(newStr)));
                    end;
                ChangedResource(Hndl);
                theError := ResError;
                if theError = noErr then
                    WriteResource(Hndl);
                HPurge(Hndl);
                ReleaseResource(Hndl);
            end
        else
            theError := resNotFound;
        SetIndString := theError;
    end; {of func SetIndString}


    function SetStr;{ (theID: Integer; newStr: Str255):OSErr}
        var
            S1: StringHandle;
            theError: Integer;
    begin
        S1 := GetString(theID);
        if Handle(S1) <> nil then
            begin
                SetString(S1, newStr);
                ChangedResource(Handle(S1));
                theError := ResError;
                if theError = noErr then
                    WriteResource(Handle(S1));
            end
        else
            theError := resNotFound;
        SetStr := theError;
    end;  { of proc SetStr }


    function CreateEmptyStr; {(theType: ResType; theID: Integer): OSErr}
        var
            Hndl: Handle;
            Amt, theError, Zero: Integer;
    begin
        Zero := 0;
        if theType = 'STR#' then    { pass any other type to create a resource containing a single zero }
            Amt := 2
        else
            Amt := 1;
        Zero := PtrToHand(Pointer(Ord(@Zero)), Hndl, Amt);
        AddResource(Hndl, theType, theID, '');
        theError := ResError;
        if theError = noErr then
            WriteResource(Hndl);
        CreateEmptyStr := theError;
    end;  { of proc CreateEmptyStr }


    function aNum2Str;{(aNum: LongInt): Str255}
        var
            NumStr: Str255;
    begin
        NumToString(aNum, NumStr);
        aNum2Str := NumStr;
    end;


    function aStr2Num;{(NumStr: Str255): LongInt}
        var
            aNum: LongInt;
    begin
        StringToNum(NumStr, aNum);
        aStr2Num := aNum
    end;


    procedure Replace;{(var strvar :  Str255; oldstr,newstr : Str255)}
        var
            location: Integer;
    begin
        location := Pos(oldstr, strvar);
        if location > 0 then
            begin
                Delete(strvar, location, Length(oldstr));
                if Length(newstr) > 0 then
                    Insert(newstr, strvar, location);
            end;
    end; { of proc Replace }


    procedure ReplaceAll;{(var strvar :  Str255; oldstr,newstr : Str255)}
        var
            location: Integer;
    begin
        location := Pos(oldstr, strvar);
        while location > 0 do
            begin
                Delete(strvar, location, Length(oldstr));
                if Length(newstr) > 0 then
                    Insert(newstr, strvar, location);
                location := Pos(oldstr, strvar);
            end;
    end; { of proc ReplaceAll }


    procedure Lower;{(var strvar : str255)}
        var
            i: Integer;
            LowDiacrits, UprDiacrits: string[29];
    begin
        LowDiacrits := 'äåàãâáæçëèêéïìîíñœöòõôóüùûúÿø';
        UprDiacrits := 'ÄÅÀÃÂÁÆÇËÈÊÉÏÌÎÍÑŒÖÒÕÔÓÜÙÛÚŸØ';
        for i := 1 to Length(strvar) do
            if (strvar[i] >= 'A') and (strvar[i] <= 'Z') then  { "normal" upper case }
                strvar[i] := Chr(Ord(strvar[i]) + 32)
            else if Pos(strvar[i], UprDiacrits) > 0 then { upper case diacriticals }
                strvar[i] := LowDiacrits[Pos(strvar[i], UprDiacrits)]
    end; { of proc Lower }


    procedure CapitalizeWords; {(var strvar: str255)}
        var
            C: Str255;
            i: Integer;
            CapNextWord: Boolean;             { capitalize next word marker }
    begin
        CapNextWord := True;
        for i := 1 to Length(strvar) do
            begin
                if (Ord(strvar[i]) in [0..32]) then            { word breaks }
                    CapNextWord := True;
                if CapNextWord and not (strvar[i] in [' ', chr(9), chr(39), '(', '[', '“', '‘', '"']) then
                    begin
                        C := strvar[i];
                        UprString(C, True);        { use toolbox to capitalize beginning of next line }
                        strvar[i] := C[1];
                        CapNextWord := False;    { reset capitalize next word var }
                    end;
            end;
    end; { of proc CapitalizeWords }

end.